home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch3 / Rainbow.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-04-01  |  5.4 KB  |  187 lines
  1. VERSION 5.00
  2. Begin VB.Form frmRainbow 
  3.    Caption         =   "Rainbow"
  4.    ClientHeight    =   3255
  5.    ClientLeft      =   2055
  6.    ClientTop       =   1320
  7.    ClientWidth     =   5415
  8.    LinkTopic       =   "Form1"
  9.    PaletteMode     =   1  'UseZOrder
  10.    ScaleHeight     =   217
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   361
  13.    Begin VB.PictureBox picDefault 
  14.       AutoRedraw      =   -1  'True
  15.       Height          =   1575
  16.       Left            =   120
  17.       ScaleHeight     =   1515
  18.       ScaleWidth      =   2475
  19.       TabIndex        =   12
  20.       Top             =   120
  21.       Width           =   2535
  22.    End
  23.    Begin VB.PictureBox picRainbow 
  24.       AutoRedraw      =   -1  'True
  25.       Height          =   1575
  26.       Left            =   2760
  27.       Picture         =   "Rainbow.frx":0000
  28.       ScaleHeight     =   101
  29.       ScaleMode       =   3  'Pixel
  30.       ScaleWidth      =   165
  31.       TabIndex        =   0
  32.       Top             =   120
  33.       Width           =   2535
  34.    End
  35.    Begin VB.HScrollBar hbarBlue 
  36.       Height          =   255
  37.       LargeChange     =   16
  38.       Left            =   1020
  39.       Max             =   255
  40.       TabIndex        =   6
  41.       Top             =   2880
  42.       Width           =   4275
  43.    End
  44.    Begin VB.HScrollBar hbarGreen 
  45.       Height          =   255
  46.       LargeChange     =   16
  47.       Left            =   1020
  48.       Max             =   255
  49.       TabIndex        =   5
  50.       Top             =   2520
  51.       Width           =   4275
  52.    End
  53.    Begin VB.HScrollBar hbarRed 
  54.       Height          =   255
  55.       LargeChange     =   16
  56.       Left            =   1020
  57.       Max             =   255
  58.       TabIndex        =   4
  59.       Top             =   2160
  60.       Width           =   4275
  61.    End
  62.    Begin VB.Label Label1 
  63.       Alignment       =   2  'Center
  64.       Caption         =   "Rainbow Palette"
  65.       Height          =   255
  66.       Index           =   5
  67.       Left            =   2760
  68.       TabIndex        =   11
  69.       Top             =   1800
  70.       Width           =   2535
  71.    End
  72.    Begin VB.Label lblBlue 
  73.       BorderStyle     =   1  'Fixed Single
  74.       Height          =   255
  75.       Left            =   600
  76.       TabIndex        =   10
  77.       Top             =   2880
  78.       Width           =   375
  79.    End
  80.    Begin VB.Label lblGreen 
  81.       BorderStyle     =   1  'Fixed Single
  82.       Height          =   255
  83.       Left            =   600
  84.       TabIndex        =   9
  85.       Top             =   2520
  86.       Width           =   375
  87.    End
  88.    Begin VB.Label lblRed 
  89.       BorderStyle     =   1  'Fixed Single
  90.       Height          =   255
  91.       Left            =   600
  92.       TabIndex        =   8
  93.       Top             =   2160
  94.       Width           =   375
  95.    End
  96.    Begin VB.Label Label1 
  97.       Alignment       =   2  'Center
  98.       Caption         =   "Default Palette"
  99.       Height          =   255
  100.       Index           =   3
  101.       Left            =   120
  102.       TabIndex        =   7
  103.       Top             =   1800
  104.       Width           =   2535
  105.    End
  106.    Begin VB.Label Label1 
  107.       Caption         =   "Blue"
  108.       Height          =   255
  109.       Index           =   2
  110.       Left            =   120
  111.       TabIndex        =   3
  112.       Top             =   2880
  113.       Width           =   495
  114.    End
  115.    Begin VB.Label Label1 
  116.       Caption         =   "Green"
  117.       Height          =   255
  118.       Index           =   1
  119.       Left            =   120
  120.       TabIndex        =   2
  121.       Top             =   2520
  122.       Width           =   495
  123.    End
  124.    Begin VB.Label Label1 
  125.       Caption         =   "Red"
  126.       Height          =   255
  127.       Index           =   0
  128.       Left            =   120
  129.       TabIndex        =   1
  130.       Top             =   2160
  131.       Width           =   495
  132.    End
  133. Attribute VB_Name = "frmRainbow"
  134. Attribute VB_GlobalNameSpace = False
  135. Attribute VB_Creatable = False
  136. Attribute VB_PredeclaredId = True
  137. Attribute VB_Exposed = False
  138. Option Explicit
  139. Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
  140. Private Const RASTERCAPS = 38
  141. Private Const RC_PALETTE = &H100
  142. ' Display the selected RGB value in all picture
  143. ' boxes.
  144. Private Sub UpdateColors()
  145. Dim r As Integer
  146. Dim g As Integer
  147. Dim b As Integer
  148.     r = hbarRed.Value
  149.     g = hbarGreen.Value
  150.     b = hbarBlue.Value
  151.     ' Update the numeric labels.
  152.     lblRed.Caption = Format$(r)
  153.     lblGreen.Caption = Format$(g)
  154.     lblBlue.Caption = Format$(b)
  155.     ' Display the color in the default picture.
  156.     picDefault.Line (0, 0)-Step(picDefault.ScaleWidth, picDefault.ScaleHeight), RGB(r, g, b), BF
  157.     ' Display the color in the rainbow picture.
  158.     picRainbow.Line (0, 0)-Step(picRainbow.ScaleWidth, picRainbow.ScaleHeight), RGB(r, g, b), BF
  159. End Sub
  160. Private Sub hbarBlue_Change()
  161.     UpdateColors
  162. End Sub
  163. Private Sub hbarBlue_Scroll()
  164.     UpdateColors
  165. End Sub
  166. Private Sub Form_Load()
  167.     ' Make sure the screen supports palettes.
  168.     If Not GetDeviceCaps(hdc, RASTERCAPS) And RC_PALETTE Then
  169.         MsgBox "This system is not using palettes.", vbCritical
  170.         End
  171.     End If
  172.     ' Display the initial color (black).
  173.     UpdateColors
  174. End Sub
  175. Private Sub hbarGreen_Change()
  176.     UpdateColors
  177. End Sub
  178. Private Sub hbarGreen_Scroll()
  179.     UpdateColors
  180. End Sub
  181. Private Sub hbarRed_Change()
  182.     UpdateColors
  183. End Sub
  184. Private Sub hbarRed_Scroll()
  185.     UpdateColors
  186. End Sub
  187.